home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 1 / Atari Mega Archive - Volume 1.iso / tex / td187src.lzh / FIG.I < prev    next >
Encoding:
Modula Implementation  |  1991-12-14  |  26.0 KB  |  852 lines
  1. IMPLEMENTATION MODULE FIG ;
  2.  
  3. (*
  4.    Versuch, ein bereits fertiges FIG-File zu interpretieren
  5.    und die Objekte zu übernehmen. Quick'n Dirty-Version.
  6.    Verbesserungen überall möglich und nötig... (JP)
  7.  
  8.    Dieses Modul ist (C)'91 by Jens Pirnay
  9. *)
  10.  
  11. FROM Dialoge         IMPORT BusyStart, BusyEnd;
  12. FROM Diverses        IMPORT GetFSelText, NumAlert, min, max;
  13. FROM FileIO          IMPORT Fopen, EOF, AgainChar, Reset, Close,
  14.                             ReadChar, UnixLine, ReadLn, AgainLine;
  15. FROM ObjectUtilities IMPORT FillObject;
  16. FROM Types           IMPORT DrawObjectTyp, TextPosTyp,
  17.                             ExtendedArraySize, CharArraySize,
  18.                             CodeAryTyp, ObjectPtrTyp;
  19. FROM SYSTEM          IMPORT BYTE, WORD, ADDRESS , ADR ;
  20. FROM Storage         IMPORT ALLOCATE , DEALLOCATE ;
  21. IMPORT CommonData ;
  22. IMPORT GetFile;
  23. IMPORT MathLib0 ;
  24. IMPORT MagicConvert ;
  25. IMPORT MagicDOS ;
  26. IMPORT MagicStrings ;
  27. IMPORT MagicSys ;
  28. IMPORT Variablen ;
  29. IMPORT mtAlerts;
  30. FROM VectorFont IMPORT LoadFont, TextWidth, TextHeight, SetTextStyle,
  31.                        SetFont, OutText,  CreateText;
  32. (**
  33. IMPORT RTD;
  34. **)
  35.  
  36. TYPE  chset = SET OF CHAR;
  37. CONST
  38.       Magic            = -29564;   (* Test auf ungültige Zahl *)
  39.       FMagic           = -29564.0; (* Test auf ungültige Zahl *)
  40.       Integers         = chset{'0'..'9','+','-'};
  41.       Reals            = chset{'0'..'9','+','-','.'};
  42.  
  43.       SolidLine        = 0;
  44.       DashLine         = 1;
  45.       DottedLine       = 2;
  46.  
  47.       OEllipse         = 1;
  48.       TEllipseByRad    = 1;
  49.       TEllipseByDia    = 2;
  50.       TCircleByRad     = 3;
  51.       TCircleByDia     = 4;
  52.  
  53.       OPolyline        = 2;
  54.       TPolyline        = 1;
  55.       TBox             = 2;
  56.       TPolygon         = 3;
  57.       TArcBox          = 4;
  58.  
  59.       OSpline          = 3;
  60.       TOpenNormal      = 1;
  61.       TClosedNormal    = 2;
  62.       TOpenInterpol    = 3;
  63.       TClosedInterpol  = 4;
  64.  
  65.       OText            = 4;
  66.       TLeftJustified   = 0;
  67.       TCenterJustified = 1;
  68.       TRightJustified  = 2;
  69.  
  70.       OArc             = 5;
  71.       T3PointArc       = 1;
  72.  
  73.       OCompound        = 6;
  74.  
  75.       OEndCompound     = -6;
  76.  
  77.  
  78. VAR   Filehandle : INTEGER;
  79.  
  80. PROCEDURE ExtractNumber(VAR str : ARRAY OF CHAR) : INTEGER;
  81. VAR i, j, res : INTEGER;
  82.     temp      : ARRAY [0..19] OF CHAR;
  83. BEGIN
  84. (**
  85.   RTD.Write('EN-In', str);
  86. **)
  87.   res := Magic;
  88.   (* Zunächst Spaces weg *)
  89.   i := 0;
  90.   WHILE (str[i]=' ') OR (str[i] = 07C) DO INC(i); END;
  91.   temp := '';
  92.   j := 0;
  93.   WHILE str[i] IN Integers DO
  94.     temp[j] := str[i];
  95.     INC(i);
  96.     INC(j);
  97.   END;
  98.   temp[j] := 0C;
  99.   WHILE (str[i]=' ') OR (str[i] = 07C) DO INC(i); END;
  100.   IF i>0 THEN
  101.     MagicStrings.Delete(str, 0, i);
  102.   END;
  103. (**
  104.   RTD.Write('EN-temp', temp);
  105. **)
  106.   IF temp[0]<>0C THEN
  107.     res := MagicConvert.StrToInt(temp);
  108.   END;
  109. (**
  110.   RTD.Write('EN-Out', str);
  111. **)
  112.   RETURN res;
  113. END ExtractNumber;
  114.  
  115. PROCEDURE ExtractFloat(VAR str : ARRAY OF CHAR) : LONGREAL;
  116. VAR i, j : INTEGER;
  117.     res  : LONGREAL;
  118.     temp : ARRAY [0..19] OF CHAR;
  119. BEGIN
  120. (**
  121.   RTD.Write('EF-In', str);
  122. **)
  123.   res := FMagic;
  124.   (* Zunächst Spaces weg *)
  125.   i := 0;
  126.   WHILE (str[i]=' ') OR (str[i] = 07C) DO INC(i); END;
  127.   temp := '';
  128.   j := 0;
  129.   WHILE str[i] IN Reals DO
  130.     temp[j] := str[i];
  131.     INC(i);
  132.     INC(j);
  133.   END;
  134.   temp[j] := 0C;
  135.   WHILE (str[i]=' ') OR (str[i] = 07C) DO INC(i); END;
  136.   IF i>0 THEN
  137.     MagicStrings.Delete(str, 0, i);
  138.   END;
  139. (**
  140.   RTD.Write('EF-temp', temp);
  141. **)
  142.   IF temp[0]<>0C THEN
  143.     res := MagicConvert.StrToReal(temp);
  144.   END;
  145. (**
  146.   RTD.Write('EF-Out', str);
  147. **)
  148.   RETURN res;
  149. END ExtractFloat;
  150.  
  151. PROCEDURE ParseFile(name : ARRAY OF CHAR) : BOOLEAN;
  152. TYPE chset     = SET OF CHAR;
  153. VAR i          : INTEGER;
  154.     ok, first  : BOOLEAN;
  155.     upperleft  : BOOLEAN;
  156.     forwarrow  : BOOLEAN;
  157.     backwarrow : BOOLEAN;
  158.     pixperinch : INTEGER;
  159.     c          : CHAR;
  160.     str, num   : ARRAY [0..255] OF CHAR;
  161.     intArray   : ARRAY [1..19] OF INTEGER;
  162.     forwArray  : ARRAY [1..5] OF INTEGER;
  163.     backwArray : ARRAY [1..5] OF INTEGER;
  164.     realArray  : ARRAY [1..19] OF LONGREAL;
  165.     charBuffer : ARRAY [0..255] OF CHAR;
  166.     Code       : CodeAryTyp;
  167.     obj        : ObjectPtrTyp;
  168.     Surround   : ARRAY [0..3] OF INTEGER;
  169.     wx         : INTEGER ;
  170.     wy         : INTEGER ;
  171.     ww         : INTEGER ;
  172.     wh         : INTEGER ;
  173.     dum        : INTEGER ;
  174.     pos        : CARDINAL;
  175.     Version    : CARDINAL;
  176.     maxx, minx,
  177.     maxy, miny : INTEGER;
  178.     MinX, MinY : INTEGER;
  179.     deltaX,
  180.     deltaY     : INTEGER;
  181.  
  182.     (* Allgemein gilt:
  183.        Falls forw_arrow = 1, so folgt eine Zeile:
  184.        %da1 %da2 %da3 %da4 %da5                   (5)
  185.        %da1 : arrow_type
  186.        %da2 : arrow_style
  187.        %da3 : arrow_thickness
  188.        %da4 : arrow_width
  189.        %da5 : arrow_height
  190.        Falls backw_arrow = 1, ebenfalls.
  191.     *)
  192.  
  193.     PROCEDURE GetLine;
  194.     BEGIN
  195.       str[0] := 0C;
  196.       IF NOT EOF THEN
  197.         ReadLn (Filehandle, str);
  198.       END;
  199.     END GetLine;
  200.  
  201.     PROCEDURE GetNewLine;
  202.     BEGIN
  203.       REPEAT
  204.         GetLine;
  205.       UNTIL str[0] <> '#';
  206.     END GetNewLine;
  207.  
  208.     PROCEDURE ScanStr(Format : ARRAY OF CHAR);
  209.     VAR i, nrint, nrreal : INTEGER;
  210.     BEGIN
  211. (*
  212.       RTD.Write('ToScan', Format);
  213. *)
  214.       FOR i := 1 TO 19 DO
  215.         intArray [i] :=  Magic;
  216.         realArray[i] := FMagic;
  217.       END;
  218.       nrint  := 0;
  219.       nrreal := 0;
  220.       FOR i := 0 TO MagicSys.CastToInt(MagicStrings.Length(Format))-1 DO
  221.         IF (Format[i] = 'd') THEN
  222.           INC(nrint);
  223.           intArray[nrint] := ExtractNumber(str);
  224.         END;
  225.         IF (Format[i] = 'f') THEN
  226.           INC(nrreal);
  227.           realArray[nrreal] := ExtractFloat(str);
  228.         END;
  229.       END;
  230.       i := nrint + nrreal;
  231. (*
  232.       RTD.ShowVar('Scanned', i);
  233. *)
  234.     END ScanStr;
  235.  
  236.     PROCEDURE Coord(integer : INTEGER) : INTEGER;
  237.     BEGIN
  238.       IF upperleft THEN
  239.         RETURN -integer;
  240.        ELSE
  241.         RETURN integer;
  242.       END;
  243.     END Coord;
  244.  
  245.     PROCEDURE CheckArrow(forw, backw : INTEGER);
  246.     VAR i : INTEGER;
  247.     BEGIN
  248.       forwarrow  := intArray[forw] =1;
  249.       backwarrow := intArray[backw]=1;
  250.       IF forwarrow THEN
  251.         GetNewLine;
  252.         FOR i:=1 TO 5 DO
  253.           forwArray[i] := ExtractNumber(str);
  254.         END;
  255.       END;
  256.       IF backwarrow THEN
  257.         GetNewLine;
  258.         FOR i:=1 TO 5 DO
  259.           backwArray[i] := ExtractNumber(str);
  260.         END;
  261.       END;
  262.     END CheckArrow;
  263.  
  264.     PROCEDURE InitCode;
  265.     VAR i : INTEGER;
  266.     BEGIN
  267.       FOR i := 0 TO 9 DO Code[i] := 0; END;
  268.       FOR i := 0 TO 3 DO Surround[i] := 0; END;
  269.       Code[8] := 1; (* Thickness *)
  270.     END InitCode;
  271.  
  272.     PROCEDURE GetArc;
  273.     VAR IsArc : BOOLEAN;
  274.         startangle, deltaangle : INTEGER;
  275.         radx, rady             : INTEGER;
  276.     BEGIN
  277.       (* Format der Arc-Beschreibung:
  278.          %d01 %d02 %d03 %d04 %d05 %d06 %d07 %f01
  279.          %d08 %d09 %d10 %f02 %f03 %d11 %d12 %d13
  280.          %d14 %d15 %d16                           (19)
  281.          mit
  282.          %d01 : type            %d02 : line_style
  283.          %d03 : line_thickness  %d04 : color
  284.          %d05 : depth           %d06 : pen
  285.          %d07 : area_fill       %f01 : style_val
  286.          %d08 : direction       %d09 : forw_arrow
  287.          %d10 : backw_arrow     %f02 : center_x
  288.          %f03 : center_y        %d11 : x_1
  289.          %d12 : y_1             %d13 : x_2
  290.          %d14 : y_2             %d15 : x_3
  291.          %d16 : y_3
  292.       *)
  293.       ScanStr('dddddddfdddffdddddd');
  294.       CheckArrow(9, 10);
  295. (*
  296.       InitCode;
  297.       Code[1] := RealCoord(realArray[2]);
  298.       Code[2] := RealCoord(realArray[3]);
  299.       IF (intArray[1] = T3PointArc) THEN
  300.         IF IsArc THEN
  301.            Code[0] := ORD(Arc);
  302.            Code[3] := radx;
  303.            Code[4] := startangle;
  304.            Code[5] := deltaangle;
  305.            Variablen.NewObject(Code, NIL, NIL, Surround);
  306.            Variablen.LastObject^.SurrDirty := TRUE;
  307.           ELSE
  308.            Code[0] := ORD(Ellipse);
  309.            Code[3] := radx;
  310.            Code[4] := rady;
  311.            Code[5] := startangle;
  312.            Code[6] := deltaangle;
  313.            Variablen.NewObject(Code, NIL, NIL, Surround);
  314.            Variablen.LastObject^.SurrDirty := TRUE;
  315.         END;
  316.       END;
  317. *)
  318.     END GetArc;
  319.  
  320.     PROCEDURE GetEllipse;
  321.     BEGIN
  322.       (* Format der Ellipse-Beschreibung:
  323.          %d01 %d02 %d03 %d04 %d05 %d06 %d07 %f01
  324.          %d08 %f02 %d09 %d10 %d11 %d12 %d13 %d14
  325.          %d15 %d16                                (18)
  326.          mit
  327.          %d01 : sub_type        %d02 : line_style
  328.          %d03 : line_thickness  %d04 : color
  329.          %d05 : depth           %d06 : pen
  330.          %d07 : area_fill       %f01 : style_val
  331.  
  332.          %d08 : direction       %f02 : angle
  333.          %d09 : center_x        %d10 : center_y
  334.          %d11 : radius_x        %d12 : radius_y
  335.          %d13 : start_x         %d14 : start_y
  336.          %d15 : end_x           %d16 : end_y
  337.       *)
  338.       ScanStr('dddddddfdfdddddddd');
  339.       InitCode;
  340.       Code[1] := Coord(intArray[9]);
  341.       Code[2] := Coord(intArray[10]);
  342.       Code[8] := 1;
  343.       IF (intArray[1] = TCircleByRad) OR
  344.          (intArray[1] = TCircleByDia) THEN
  345.          Code[0] := ORD(Circle);
  346.          Code[3] := intArray[11];
  347.          Variablen.NewObject(Code, NIL, NIL, Surround);
  348.          Variablen.LastObject^.SurrDirty := TRUE;
  349.         ELSIF (intArray[1] = TEllipseByRad) OR
  350.               (intArray[1] = TEllipseByDia) THEN
  351.          Code[0] := ORD(Ellipse);
  352.          Code[3] := intArray[11];
  353.          Code[4] := intArray[12];
  354.          Code[5] := 0;
  355.          Code[6] := 360;
  356.          Variablen.NewObject(Code, NIL, NIL, Surround);
  357.          Variablen.LastObject^.SurrDirty := TRUE;
  358.       END;
  359.  
  360.     END GetEllipse;
  361.  
  362.     PROCEDURE GetPolyline;
  363.     VAR special : BOOLEAN; i, x, y : INTEGER;
  364.     BEGIN
  365.       (* Format der Polyline-Beschreibung:
  366.          %d01 %d02 %d03 %d04 %d05 %d06 %d07 %f01
  367.          %d08 %d09                                (10) (TFX-1.4)
  368.          bei %d01 = 4 (s.u.)
  369.          %d08 %d09 %d10                           (11) (FIG-2.0)
  370.          mit
  371.          %d01 : sub_type        %d02 : line_style
  372.          %d03 : line_thickness  %d04 : color
  373.          %d05 : depth           %d06 : pen
  374.          %d07 : area_fill       %f01 : style_val
  375.  
  376.          %d08 : forw_arrow      %d09 : backw_arrow (TFX-1.4)
  377.          bzw. falls sub_type=4 (T_ARC_BOX)
  378.          %d08 : radius          %d09 : forw_arrow
  379.          %d10 : backw_arrow
  380.  
  381.          Zunächst folgen eventuelle arrow-Beschreibungen (s.o), dann
  382.          Koordinatenpaare, die vom speziellen Paar 9999 9999 abge-
  383.          schlossen werden.
  384.  
  385.       *)
  386.       InitCode;
  387.       ScanStr('dddddddfdd');
  388.       CASE intArray[2] OF
  389.         DottedLine : Code[0] := ORD(EpicDottedLine); |
  390.         DashLine   : Code[0] := ORD(EpicDashedLine); |
  391.        ELSE
  392.         Code[0] := ORD(EpicSolidLine);
  393.       END;
  394.  
  395.       IF intArray[1] = TArcBox THEN
  396.         intArray[10] := ExtractNumber(str);
  397.         CheckArrow(9, 10);
  398.         special := TRUE;
  399.        ELSE
  400.         CheckArrow(8, 9);
  401.         special := FALSE;
  402.       END;
  403.       x := Coord(9999);
  404.       y := x;
  405.       Code[3] := -1;
  406.       IF forwarrow  THEN INC(Code[5], 2); END;
  407.       IF backwarrow THEN INC(Code[5], 1); END;
  408.       REPEAT
  409.         GetNewLine;
  410.         WHILE (str[0]<>0C) DO
  411.           x := Coord(ExtractNumber(str));
  412.           y := Coord(ExtractNumber(str));
  413.           IF (x<>Coord(9999)) OR (y<>Coord(9999)) THEN
  414.             INC(Code[3]);
  415.             IF Code[3] = 0 THEN
  416.               Code[1] := x;
  417.               Code[2] := y;
  418.               maxx := x; minx := x; IF minx<MinX THEN MinX := minx; END;
  419.               maxy := y; miny := y; IF miny<MinY THEN MinY := miny; END;
  420.              ELSIF 2*(Code[3]+1)>=ExtendedArraySize-1 THEN
  421.               (* Objekt erzeugen, anschließend auf Anfangszustand *)
  422.               DEC(Code[3]);
  423.               Surround[0] := minx;
  424.               Surround[1] := maxy;
  425.               Surround[2] := maxx - minx;
  426.               Surround[3] := maxy - miny;
  427.               Variablen.NewObject(Code, NIL, ADR(Variablen.ebuffer), Surround);
  428.               maxx := x; minx := x; IF minx<MinX THEN MinX := minx; END;
  429.               maxy := y; miny := y; IF miny<MinY THEN MinY := miny; END;
  430.               Code[3] := 0;
  431.               Code[1] := x;
  432.               Code[2] := y;
  433.              ELSE
  434.               minx := min(x, minx);
  435.               maxx := max(x, maxx);
  436.               miny := min(y, miny);
  437.               maxy := max(y, maxy);
  438.               IF minx<MinX THEN MinX := minx; END;
  439.               IF miny<MinY THEN MinY := miny; END;
  440.               Variablen.ebuffer[2*(Code[3]-1)  ] := x - Code[1];
  441.               Variablen.ebuffer[2*(Code[3]-1)+1] := y - Code[2];
  442.             END;
  443.           END;
  444.         END;
  445.       UNTIL ((x=Coord(9999)) AND (y=Coord(9999))) OR EOF;
  446.       IF Code[3]>0 THEN
  447.         IF (intArray[1] = TBox) AND
  448.            ((intArray[2] = DashLine) OR
  449.             (intArray[2] = SolidLine)) THEN
  450.           IF intArray[2] = DashLine THEN
  451.             Code[0] := ORD(Dashbox);
  452.            ELSE
  453.             Code[0] := ORD(Framebox);
  454.           END;
  455.           Code[1] := minx;
  456.           Code[2] := miny;
  457.           Code[3] := (maxx-minx);
  458.           Code[4] := (maxy-miny);
  459.          ELSE
  460.           Variablen.NewObject(Code, NIL, ADR(Variablen.ebuffer), Surround);
  461.           Variablen.LastObject^.SurrDirty := TRUE;
  462.         END;
  463.       END;
  464.     END GetPolyline;
  465.  
  466.     PROCEDURE GetSpline;
  467.     VAR i, x,  y  : INTEGER;
  468.         cx1, cy1  : LONGREAL;
  469.         cx2, cy2  : LONGREAL;
  470.         anzahl    : INTEGER;
  471.     BEGIN
  472.       (* Format der Spline-Beschreibung:
  473.          %d01 %d02 %d03 %d04 %d05 %d06 %d07 %f01
  474.          %d08 %d09                                (10)
  475.          mit
  476.          %d01 : sub_type        %d02 : line_style
  477.          %d03 : line_thickness  %d04 : color
  478.          %d05 : depth           %d06 : pen
  479.          %d07 : area_fill       %f01 : style_val
  480.  
  481.          %d08 : forw_arrow      %d09 : backw_arrow
  482.       *)
  483.       ScanStr('dddddddfdd');
  484.       CheckArrow(8, 9);
  485.       InitCode;
  486.       CASE intArray[2] OF
  487.         DottedLine : Code[0] := ORD(EpicDottedLine); |
  488.         DashLine   : Code[0] := ORD(EpicDashedLine); |
  489.        ELSE
  490.         Code[0] := ORD(EpicSolidLine);
  491.       END;
  492.       Code[3] := -1;
  493.       IF forwarrow  THEN INC(Code[5], 2); END;
  494.       IF backwarrow THEN INC(Code[5], 1); END;
  495.       REPEAT
  496.         GetNewLine;
  497.         WHILE (str[0]<>0C) DO
  498.           x := Coord(ExtractNumber(str));
  499.           y := Coord(ExtractNumber(str));
  500.           IF (x<>Coord(9999)) OR (y<>Coord(9999)) THEN
  501.             INC(Code[3]);
  502.             IF Code[3] = 0 THEN
  503.               Code[1] := x;
  504.               Code[2] := y;
  505.               maxx := x; minx := x;
  506.               maxy := y; miny := y;
  507.               IF minx<MinX THEN MinX := minx; END;
  508.               IF miny<MinY THEN MinY := miny; END;
  509.              ELSIF 2*(Code[3]+1)>=ExtendedArraySize-1 THEN
  510.               (* Objekt erzeugen, anschließend auf Anfangszustand *)
  511.               DEC(Code[3]);
  512.               Surround[0] := minx;
  513.               Surround[1] := maxy;
  514.               Surround[2] := maxx - minx;
  515.               Surround[3] := maxy - miny;
  516.               Variablen.NewObject(Code, NIL, ADR(Variablen.ebuffer), Surround);
  517.               maxx := x; minx := x;
  518.               maxy := y; miny := y;
  519.               IF minx<MinX THEN MinX := minx; END;
  520.               IF miny<MinY THEN MinY := miny; END;
  521.               Code[3] := 0;
  522.               Code[1] := x;
  523.               Code[2] := y;
  524.              ELSE
  525.               IF x>maxx THEN maxx := x; END;
  526.               IF x<minx THEN minx := x; END;
  527.               IF y>maxy THEN maxy := y; END;
  528.               IF y<miny THEN miny := y; END;
  529.               IF minx<MinX THEN MinX := minx; END;
  530.               IF miny<MinY THEN MinY := miny; END;
  531.               Variablen.ebuffer[2*(Code[3]-1)  ] := x - Code[1];
  532.               Variablen.ebuffer[2*(Code[3]-1)+1] := y - Code[2];
  533.             END;
  534.           END;
  535.         END;
  536.       UNTIL ((x=Coord(9999)) AND (y=Coord(9999))) OR EOF;
  537.       IF (intArray[1] = TOpenInterpol) OR
  538.          (intArray[1] = TClosedInterpol) THEN
  539.         anzahl := Code[3] + 1;
  540.         REPEAT
  541.           GetNewLine;
  542.           WHILE (str[0]<>0C) AND (anzahl>0) DO
  543.             cx1 := ExtractFloat(str);
  544.             cy1 := ExtractFloat(str);
  545.             cx2 := ExtractFloat(str);
  546.             cy2 := ExtractFloat(str);
  547.             DEC(anzahl);
  548.           END;
  549.         UNTIL (anzahl=0) OR EOF;
  550.       END;
  551.       IF Code[3]>0 THEN
  552.         Variablen.NewObject(Code, NIL, ADR(Variablen.ebuffer), Surround);
  553.         Variablen.LastObject^.SurrDirty := TRUE;
  554.       END;
  555.     END GetSpline;
  556.  
  557.     PROCEDURE GetText;
  558.     VAR ready : BOOLEAN;
  559.         count : INTEGER;
  560.     BEGIN
  561.       (* Format der Text-Beschreibung:
  562.          %d01 %d02 %d03 %d04 %d05 %d06 %f01 %d07
  563.          %d08 %d09 %d10 %d11                     (12)
  564.          mit
  565.          %d01 : sub_type        %d02 : font
  566.          %d03 : font_size       %d04 : pen
  567.          %d05 : color           %d06 : depth
  568.          %f01 : angle           %d07 : font_style
  569.          %d08 : height          %d09 : length
  570.          %d10 : base_x          %d11 : base_y
  571.          Darauf folgt der Text bis entweder EOF oder aber das
  572.          Textende-Zeichen ^A (01C) folgt. Man beachte, dass
  573.          der Text in mehreren Zeilen stehen darf.
  574.       *)
  575.       ScanStr('ddddddfddddd');
  576.       ready := FALSE;
  577.       count := 0;
  578.       IF str[0]<>0C THEN
  579.         i := 0;
  580.         WHILE (str[i]<>0C) DO
  581.           IF str[i] = 01C THEN
  582.             ready := TRUE;
  583.             str[i] := 0C;
  584.             charBuffer[count] := 0C;
  585. (*
  586.             RTD.Write('Text-Line', str);
  587. *)
  588.            ELSE
  589.             IF (count<CharArraySize) THEN
  590.               charBuffer[count] := str[i];
  591.               INC(count);
  592.             END;
  593.             INC(i);
  594.           END;
  595.         END;
  596.       END;
  597.       WHILE NOT EOF AND NOT ready DO
  598.         GetLine;
  599.         IF (count+1<CharArraySize) THEN
  600.           charBuffer[count]   := '\';
  601.           charBuffer[count+1] := '\';
  602.           INC(count, 2);
  603.         END;
  604.         i := 0;
  605.         WHILE str[i]<>0C DO
  606.           IF str[i] = 01C THEN
  607.             ready := TRUE;
  608.             str[i] := 0C;
  609.             charBuffer[count] := 0C;
  610. (*
  611.             RTD.Write('Text-Line(s)', str);
  612. *)
  613.            ELSE
  614.             IF (count<CharArraySize) THEN
  615.               charBuffer[count] := str[i];
  616.               INC(count);
  617.             END;
  618.             INC(i);
  619.           END;
  620.         END;
  621.       END;
  622.       IF count>0 THEN
  623.         InitCode;
  624.         Code[0] := ORD(Framebox);
  625.         Code[1] := Coord(intArray[10]);
  626.         Code[2] := Coord(intArray[11]);
  627.         Code[3] := intArray[8];
  628.         Code[4] := intArray[9];
  629.         Code[6] := 1; (* Flag für makebox *)
  630.         CASE intArray[1] OF
  631.           TLeftJustified   : Code[5] := ORD(LeftBot); |
  632.           TCenterJustified : Code[5] := ORD(Bottom); |
  633.           TRightJustified  : Code[5] := ORD(RightBot); |
  634.          ELSE
  635.           Code[5] := ORD(NoJust);
  636.         END;
  637.         Code[7] := 1;
  638.         Code[8] := 1;
  639.         Code[9] := count;
  640.         Variablen.NewObject(Code, ADR(charBuffer), NIL, Surround);
  641.         Variablen.LastObject^.SurrDirty := TRUE;
  642.       END;
  643.     END GetText;
  644.  
  645.     PROCEDURE GetCompound;
  646.     VAR obj, last  : ObjectPtrTyp;
  647.         ready      : BOOLEAN;
  648.     BEGIN
  649.       (* Format der Compound-Beschreibung:
  650.          %d01 %d02 %d03 %d04              (4)
  651.          mit
  652.          %d01 : up_right_x      %d02 : up_right_y
  653.          %d03 : low_left_x      %d04 : low_left_y
  654.       *)
  655.       ScanStr('dddd');
  656.       InitCode;
  657.       Code[0] := ORD(Picture);
  658.       Code[1] := Coord(intArray[3]);
  659.       Code[2] := Coord(intArray[4]);
  660.       Surround[0] := Coord(intArray[3]);
  661.       Surround[1] := Coord(intArray[2]);
  662.       Surround[2] := ABS(intArray[1] - intArray[3]);
  663.       Surround[3] := ABS(intArray[2] - intArray[4]);
  664.       Variablen.NewObject(Code, NIL, NIL, Surround);
  665.       Variablen.LastObject^.SurrDirty := TRUE;
  666.       last := Variablen.LastObject;
  667.       (* Und nun die Sache nochmals *)
  668.       ready := FALSE;
  669.       WHILE NOT EOF AND NOT ready DO
  670.         GetNewLine;
  671. (*
  672.         RTD.Write('str', str);
  673. *)
  674.         dum := ExtractNumber(str);
  675.         CASE dum OF
  676.           OEllipse     : (* Ellipse  *) (** RTD.Message('Ellipse'); **)
  677.                              GetEllipse; |
  678.           OPolyline    : (* Polyline *) (** RTD.Message('Polyline'); **)
  679.                              GetPolyline; |
  680.           OSpline      : (* Spline   *) (** RTD.Message('Spline'); **)
  681.                              GetSpline; |
  682.           OText        : (* Text     *) (** RTD.Message('Text'); **)
  683.                              GetText; |
  684.           OArc         : (* Arc      *) (** RTD.Message('Arc'); **)
  685.                              GetArc; |
  686.           OCompound    : (* Compound *) (** RTD.Message('Compound'); **)
  687.                              GetCompound; |
  688.           OEndCompound : (* End of C.*) (** RTD.Message('End of C.'); **)
  689.                              ready := TRUE; |
  690.          ELSE
  691.           (* Unknown type *) (** RTD.Message('c-Unknown type'); **)
  692.         END;
  693.       END;
  694.       IF last^.Next<>NIL THEN
  695.         (* Korrigiere bei allen folgenden Objekten
  696.            Koordinaten und Surround-Box...  *)
  697.         obj := last^.Next;
  698.         WHILE obj<>NIL DO
  699.           obj^.Code[1] := obj^.Code[1] - last^.Code[1];
  700.           obj^.Code[2] := obj^.Code[2] - last^.Code[2];
  701.           obj^.Surround[0] := obj^.Surround[0] - last^.Code[1];
  702.           obj^.Surround[1] := obj^.Surround[1] - last^.Code[2];
  703.           obj := obj^.Next;
  704.         END;
  705.         last^.Children := last^.Next;
  706.         last^.Next := NIL;
  707.         Variablen.LastObject := last;
  708.        ELSE
  709.         Variablen.DeleteObject(last);
  710.       END;
  711.     END GetCompound;
  712.  
  713. BEGIN
  714.   Reset(Filehandle, name);
  715.   IF Filehandle >= 6 THEN
  716.     GetLine;
  717.     (* steht in der ersten Zeile ein "#FIG" ? *)
  718.     pos := MagicStrings.Pos('#FIG', str);
  719.     Close(Filehandle);
  720.     ok := pos = 0;
  721.     IF NOT ok THEN
  722.       mtAlerts.SetIcon(mtAlerts.Graphic);
  723. (**
  724.       i := Alert(1, NoFIGFile);
  725. **)
  726.       i := NumAlert(5, 1);
  727.       ok := i = 2;
  728.     END;
  729.     IF ok THEN
  730.  
  731.       BusyStart(name, TRUE);
  732.  
  733.       MinX := 0;
  734.       MinY := 0;
  735.  
  736.       Reset(Filehandle, name);
  737.       EOF            := FALSE;
  738.       Variablen.DeleteWholeTree;
  739.       first := TRUE;
  740.       WHILE NOT EOF DO
  741.         GetNewLine;
  742.         (** RTD.Write('str', str); **)
  743.         dum := ExtractNumber(str);
  744.         IF first THEN
  745.           (* fig_resolution | coordinate_system *)
  746.           pixperinch := dum;
  747.           dum := ExtractNumber(str);
  748.           upperleft := dum = 2;
  749.           first := FALSE;
  750.          ELSE
  751.           CASE dum OF
  752.             OEllipse     : (* Ellipse  *) (** RTD.Message('Ellipse'); **)
  753.                                GetEllipse; |
  754.             OPolyline    : (* Polyline *) (** RTD.Message('Polyline'); **)
  755.                                GetPolyline; |
  756.             OSpline      : (* Spline   *) (** RTD.Message('Spline'); **)
  757.                                GetSpline; |
  758.             OText        : (* Text     *) (** RTD.Message('Text'); **)
  759.                                GetText; |
  760.             OArc         : (* Arc      *) (** RTD.Message('Arc'); **)
  761.                                GetArc; |
  762.             OCompound    : (* Compound *) (** RTD.Message('Compound'); **)
  763.                                GetCompound; |
  764.             OEndCompound : (* End of C.*) (** RTD.Message('End of C.'); **) |
  765.            ELSE
  766.             (* Unknown type *) (** RTD.Message('Unknown type'); **)
  767.           END;
  768.         END;
  769.       END;
  770.       Close(Filehandle);
  771.  
  772.       (* Setze Auflösung auf 1/100 inch (1/80 geht nicht) *)
  773.       Variablen.FirstObject^.Code[6] := 4 + 0100H * 3 ; (* 1/100 in *)
  774.       Variablen.FirstObject^.Code[7] := 1;     (* 1 Pixel per unit *)
  775.       CommonData.InternalResolution  := 1;
  776.       (* Und nun zum Schluss wird die ganze Zeichnung in den
  777.          positiven Zeichenbereich verschoben...  *)
  778.       IF (MinX<0) OR (MinY<0) THEN
  779.         IF MinX < 0 THEN
  780.           deltaX := -MinX;
  781.          ELSE
  782.           deltaX := 0;
  783.         END;
  784.         IF MinY < 0 THEN
  785.           deltaY := -MinY;
  786.          ELSE
  787.           deltaY := 0;
  788.         END;
  789.         obj := Variablen.FirstObject^.Next;
  790.         WHILE obj<>NIL DO
  791.           obj^.Code[1] := obj^.Code[1] + deltaX;
  792.           obj^.Code[2] := obj^.Code[2] + deltaY;
  793.           IF NOT obj^.SurrDirty THEN
  794.             obj^.Surround[0] := obj^.Surround[0] + deltaX;
  795.             obj^.Surround[1] := obj^.Surround[1] + deltaY;
  796.           END;
  797.           obj := obj^.Next;
  798.         END;
  799.       END;
  800.       BusyEnd;
  801.       RETURN TRUE;
  802.     END;
  803.     RETURN FALSE;
  804.   END;
  805. END ParseFile;
  806.  
  807. PROCEDURE ReadIt ( ) : BOOLEAN ;
  808. (*
  809.   Fragt nach Dateinamen, lädt Datei ein, versucht sie zu interpretieren,
  810.   und die Objekte abzulegen. Unbekannte Objekte werden ignoriert.
  811.   Die bisherigen Objekte werden gelöscht.
  812. *)
  813. VAR input, titel, msg : ARRAY [0..255] OF CHAR;
  814.     tmp1, tmp2        : ARRAY [0..14] OF CHAR;
  815.     res, exist        : BOOLEAN;
  816.     dum               : INTEGER;
  817. BEGIN
  818.   res := FALSE;
  819.   GetFSelText(6, msg);
  820.   tmp1 := '*.';
  821.   tmp2 := '.';
  822.   MagicStrings.Append(CommonData.Extensions[6], tmp1);
  823.   MagicStrings.Append(CommonData.Extensions[6], tmp2);
  824.   IF GetFile.GetFileName(input, titel, tmp1, tmp2,
  825.                          CommonData.FIGPath, msg,
  826.                           exist, FALSE, TRUE, TRUE, FALSE) THEN
  827.     IF exist THEN
  828.       MagicStrings.Assign(input, CommonData.FileName);
  829.       GetFile.ReplaceExtension(CommonData.FileName, CommonData.Extensions[1]);
  830.       GetFile.ReplacePath(CommonData.FileName, '');
  831.       res := ParseFile(input);
  832.      ELSE
  833.       res := FALSE;
  834.     END;
  835.   END;
  836.   RETURN res;
  837. END ReadIt;
  838.  
  839. PROCEDURE WriteIt();
  840. VAR dum : INTEGER;
  841. BEGIN
  842.   UnixLine := TRUE; (* Zeilen enden mit LF *)
  843.   dum := NumAlert(3, 1);
  844.   UnixLine := FALSE; (* Zeilen enden mit CR LF *)
  845. END WriteIt;
  846.  
  847. (**
  848. BEGIN
  849.   RTD.SetDevice(RTD.printer);
  850. **)
  851. END (* of implementation module *) FIG .
  852.